home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE07 / HTMLVIEW / HTMLVIEW.ZIP / DEMOSRC.ZIP / FONTDLG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-11  |  4.9 KB  |  188 lines
  1. unit Fontdlg;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ColorGrd, Htmlview, Spin;
  8.  
  9. type
  10.   TFontForm = class(TForm)
  11.     FontListBox: TListBox;
  12.     FontColorGrid: TColorGrid;
  13.     HotSpotColorGrid: TColorGrid;
  14.     BackListBox: TListBox;
  15.     OKButton: TButton;
  16.     Cancel: TButton;
  17.     ResetButton: TButton;
  18.     FontViewer: THTMLViewer;
  19.     FontSizeEdit: TSpinEdit;
  20.     Label1: TLabel;
  21.     Label2: TLabel;
  22.     Label3: TLabel;
  23.     Label4: TLabel;
  24.     Label5: TLabel;
  25.     procedure FormCreate(Sender: TObject);
  26.     procedure FormShow(Sender: TObject);
  27.     procedure ResetButtonClick(Sender: TObject);
  28.     procedure HotSpotColorGridChange(Sender: TObject);
  29.     procedure FontColorGridChange(Sender: TObject);
  30.     procedure ListBoxClicks(Sender: TObject);
  31.   private
  32.     { Private declarations }
  33.     FFontColor: TColor;
  34.     FHotSpotColor: TColor;
  35.     FFontSize: integer;
  36.     InitialFontName: string;
  37.     InitialFontSize: integer;
  38.     InitialFontColor: TColor;
  39.     InitialHotSpotColor: TColor;
  40.     InitialBackground: TColor;
  41.     procedure AddItem(const Value: string);
  42.     function GetFontName: TFontName;
  43.     procedure SetFontName(Value: TFontName);
  44.     function GetBackground: TColor;
  45.     procedure SetBackground(Value: TColor);
  46.     procedure SetFontColor(Value: TColor);
  47.     procedure SetHotSpotColor(Value: TColor);
  48.     procedure SetFontSize(Value: integer);
  49.   public
  50.     { Public declarations }
  51.     property FontName: TFontName read GetFontName write SetFontName;
  52.     property Background: TColor read GetBackground write SetBackground;
  53.     property FontColor: TColor read FFontColor write SetFontColor;
  54.     property FontSize: integer read FFontSize write SetFontSize;
  55.     property HotSpotColor: TColor read FHotSpotColor write SetHotSpotColor;
  56.   end;
  57.  
  58. var
  59.   FontForm: TFontForm;
  60.  
  61. implementation
  62.  
  63. {$R *.DFM}
  64. const
  65.   ViewText: string =
  66.      '<center><h1>Heading</h1></center>'+
  67.      '<ul>Some normal text.'+
  68.      '<li><a href=NoWhere>First HotSpot Item</a>'+
  69.      '<li><b>Bold Text</b>'+
  70.      '<li><i>Italicized Text</i>'+
  71.      '<li><code>Code Text</code>'+
  72.      '</ul>'+
  73.      '<hr>';
  74.  
  75. procedure TFontForm.FormCreate(Sender: TObject);
  76. begin
  77. FontListBox.Items := Screen.Fonts;
  78. GetColorValues(AddItem);
  79. FontViewer.LoadFromBuffer(@ViewText[1], Length(ViewText));
  80. end;
  81.  
  82. procedure TFontForm.AddItem(const Value: string);
  83. var
  84.   Color: TColor;
  85. begin
  86. Color := StringToColor(Value);
  87. if (Color >= 0) or (Color = -16) or (Color = -6) or (Color = -2) then
  88.   BackListBox.Items.Add(Value);
  89. end;
  90.  
  91. function TFontForm.GetFontName: TFontName;
  92. begin
  93. Result := FontListBox.Items[FontListBox.ItemIndex];
  94. end;
  95.  
  96. procedure TFontForm.SetFontName(Value: TFontName);
  97. var
  98.   I: integer;
  99. begin
  100. I := FontListBox.Items.IndexOf(Value);
  101. if I < 0 then
  102.   I := FontListBox.Items.IndexOf('System');
  103. FontListBox.ItemIndex := I;
  104. FontViewer.DefFontName := Value;
  105. end;
  106.  
  107. function TFontForm.GetBackground: TColor;
  108. begin
  109. Result := StringToColor(BackListBox.Items[BackListBox.ItemIndex]);
  110. end;
  111.  
  112. procedure TFontForm.SetBackground(Value: TColor);
  113. var
  114.   I: integer;
  115.   S: string[80];
  116. begin
  117. S := ColorToString(Value);
  118. I := BackListBox.Items.IndexOf(S);
  119. if I < 0 then
  120.   begin
  121.   BackListBox.Items.Add(S);
  122.   I := BackListBox.Items.IndexOf(S);
  123.   end;
  124. BackListBox.ItemIndex := I;
  125. FontViewer.DefBackground := Value;
  126. end;
  127.  
  128. procedure TFontForm.SetFontSize(Value: integer);
  129. begin
  130. FontViewer.DefFontSize := Value;
  131. FFontSize := Value;
  132. FontSizeEdit.Value := Value;
  133. end;
  134.  
  135. procedure TFontForm.SetFontColor(Value: TColor);
  136. begin
  137. FontViewer.DefFontColor := Value;
  138. FFontColor := Value;
  139. FontColorGrid.ForegroundEnabled := False;
  140. end;
  141.  
  142. procedure TFontForm.SetHotSpotColor(Value: TColor);
  143. begin
  144. FontViewer.DefHotSpotColor := Value;
  145. FHotSpotColor := Value;
  146. HotSpotColorGrid.ForegroundEnabled := False;
  147. end;
  148.  
  149. procedure TFontForm.FormShow(Sender: TObject);
  150. begin
  151. InitialFontName := GetFontName;
  152. InitialFontColor := FFontColor;
  153. InitialHotSpotColor := FHotSpotColor;
  154. InitialBackground := GetBackground;
  155. InitialFontSize := FFontSize;
  156. end;
  157.  
  158. procedure TFontForm.ResetButtonClick(Sender: TObject);
  159. begin
  160. FontName := InitialFontName;
  161. FontSize := InitialFontSize;
  162. FontColor := InitialFontColor;
  163. HotSpotColor := InitialHotSpotColor;
  164. Background := InitialBackground;
  165. end;
  166.  
  167. procedure TFontForm.HotSpotColorGridChange(Sender: TObject);
  168. begin
  169. HotSpotColor := HotSpotColorGrid.ForegroundColor;
  170. end;
  171.  
  172. procedure TFontForm.FontColorGridChange(Sender: TObject);
  173. begin
  174. FontColor := FontColorGrid.ForegroundColor;
  175. end;
  176.  
  177. procedure TFontForm.ListBoxClicks(Sender: TObject);
  178. begin
  179. if Sender = FontListBox then
  180.   FontName := FontListBox.Items[FontListBox.ItemIndex]
  181. else if Sender = BackListBox then
  182.   Background := StringToColor(BackListBox.Items[BackListBox.ItemIndex])
  183. else if Sender = FontSizeEdit then
  184.   FontSize := FontSizeEdit.Value;
  185. end;
  186.  
  187. end.
  188.